perm filename OPENIT.FAI[SCR,LCS] blob sn#544430 filedate 1980-11-07 generic text, type T, neo UTF8
; FORTRAN LOOKUP ROUTINE -- STUFFS NEW CODE INTO IFILE-OFILE
; CAN USE DEVICE NUMBERS 1, 20, 21, 22, 23, 24   (BUT NO PPN'S YET)

	TITLE OPENIT
	INTERNAL OPENIT
	EXTERNAL FCM1,TEMP.,IFILE,OFILE
;;	EXTERNAL FCM1,FNCTN.,TEMP.,IFILE,OFILE

NOEXT:	PUSHJ 17,ZEXT
YESEXT:	PUSHJ 17,ZEXT+2
ZEXT:	SETZM TEMP.+1	;FOR NO EXTENSION
	POPJ 17,
	MOVE 0,EXT#
	MOVEM TEMP.+1	;STUFF IN THE EXTENSION
	POPJ 17,
NOFIND:	JRST NOFILE
NOFILE:	OUTSTR [ASCIZ/***** FILE NOT FOUND *****/]
	EXIT

;   CALL OPENIT(DEVICE#,NAME,EXT,[IN=0  OUT=1])

OPENIT:	0
	MOVE 0,NOFIND
	MOVEM 0,FCM1+14		;STUFF IN NO FILE FOUND TRAP
	MOVE 0,@(16)
	MOVEM 0,DEVICE#
	MOVE 0,@1(16)
	MOVEM 0,NAME#
	MOVE 0,@2(16)
	JUMPE 0,NONE		;0 OR BLANK OK FOR NO EXTENSION
	CAMN 0,[ASCIZ/     /]	;SEND EXTENSION IN A5 FORMAT ONLY!!!
	JRST NONE
	MOVEM 0,EX#		;NOW CONVERT EXTENSION TO SIXBIT
	MOVE 1,[POINT 7,EX]
	MOVE 2,[POINT 6,EXT]
	SETZM EXT#
	MOVEI 3,3	;LOOK AT FIRST 3 CHARACTERS ONLY
INF1:	ILDB 0,1	;LOOP 3 TIMES
	CAIN 0," "	;LESS THAN 3 CHARACTERS?
	JRST OPE2
	SUBI 0,40
	IDPB 0,2
	SOJG 3,INF1
OPE2:	MOVE 0,YESEXT	;THERE IS AN EXTENSION
	SKIPA
NONE:	MOVE 0,NOEXT	;NO EXTENSION
;;	MOVEM 0,FNCTN.-7  ;ONLY NEEDS ONE LOOKUP NOW.
  	MOVEM 0,FCM1-3	;CAUSES BOTH FORTRAN LOOKUPS TO DO THE SAME THING.
	SKIPE @3(16)	;0=INPUT  1=OUTPUT
	JRST OUTFIL
	JSA 16,IFILE	;OLD FORTRAN ROUTINES
	JUMP DEVICE
	JUMP NAME
	JRA 16,4(16)
OUTFIL:	JSA 16,OFILE	;OLD FORTRAN ROUTINES
	JUMP DEVICE
	JUMP NAME
	JRA 16,4(16)
	END